home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / HOLE.ZIP / HOLE.PAS < prev   
Pascal/Delphi Source File  |  1995-05-03  |  7KB  |  212 lines
  1. {                       T H E   H O L E . v 1.0                              }
  2. {                                                                            }
  3. { The first version coded by Spanish Lords in Feb 95 for RASANTE filling hole}
  4. { This release is for public domain, but really I comment this code for      }
  5. { Eduard Sànchez Palazón, he asked me for the hole in BUTIFARRA 3 (April 95) }
  6. { Eduard:                                                                    }
  7. {     ■ Here is the code you can see is NOT 3D , only 2D, :)                 }
  8. {     ■ It is totally coment, too much I think.                              }
  9. {     ■ One kiss for Aitak ;-)                                               }
  10. {                                                                            }
  11. { I studied the original code from Bas van Gaalen, Holland, PD.- Greetings.- }
  12. {                                                                            }
  13. {                                                   <τom / Spanish Lords     }
  14. { If you want to contact with us e-mail us:                pedro@cedex.es    }
  15. { We need artist and musicians, coders are welcome too. ;-)                  }
  16. {$R-,Q-}
  17. Program The_Hole;
  18.  
  19. Uses Crt;
  20.  
  21. Const
  22.   IncAng      =       6;{ Steps in angle for drawing each circle.}
  23.   XMov        =       4;{ Moving constans.}
  24.   YMov        =       5;
  25.  
  26. var
  27.   SinTable    : array[0..449] of integer; { Sinus Table. 499=359+90 cos(φ)=sin(φ+90)}
  28.   SinMov      : array[0..255] of integer; { Sinus table for movement.}
  29.   CosMov      : array[0..255] of integer; { Cosinus table for movement.}
  30.   Buffer      : pointer;                  { Here we will write.}
  31.   BufferSeg   : word;
  32.   IncLong     : byte;                     { Inc in distance between two circles.}
  33. { ■ Do you need any comment of this procedure? }
  34. { ■ Yes ?                                      }
  35. { ■ Then, you are a lamer, dont read any more. }
  36. Procedure SetColor(Col,R,G,B:Byte); assembler;
  37. Asm
  38.   cli
  39.   mov dx,03C8H
  40.   mov al,Col
  41.   out dx,al
  42.   inc dx
  43.   mov al,r
  44.   out dx,al
  45.   mov al,g
  46.   out dx,al
  47.   mov al,b
  48.   out dx,al
  49.   sti
  50. End;
  51. { Make a degradated for the hole in colors 16..32.}
  52. { The init R,G,B are the most dark color.         }
  53. Procedure MakeDegradated (InitR,InitG,InitB:Byte);
  54. Var
  55.   CntColor : Byte;
  56.   Procedure MyDec (Var Val:Byte;Inc:Byte);Begin If Val>Inc then Dec (Val,Inc) else Val:=0;End;
  57. Begin
  58.   For CntColor:=32 downto 16 do
  59.     Begin
  60.       SetColor (CntColor,InitR,InitG,InitB);
  61.       MyDec (InitR,4);
  62.       MyDec (InitG,4);
  63.       MyDec (InitB,4);
  64.     End;
  65. End;
  66. { Clear the buffer where we will write the hole.}
  67. Procedure ClearBuffer; assembler;
  68. Asm
  69.   mov ax,BufferSeg
  70.   mov es,ax
  71.   xor di,di
  72.   xor ax,ax
  73.   mov cx,32000
  74.   rep stosw
  75. End;
  76. { Put in A000h the buffer where we are painting pixels.}
  77. { ■ In RASANTE HOLE all of this is XMode, QUICK!       }
  78. Procedure PutBuffer; assembler;
  79. Asm
  80.   push ds
  81.   mov ax,0A000h
  82.   mov es,ax
  83.   mov ax,BufferSeg
  84.   mov ds,ax
  85.   xor si,si
  86.   xor di,di
  87.   mov cx,32000
  88.   rep movsw
  89.   pop ds
  90. End;
  91. { I hope everybody know what it is this. }
  92. Procedure CalcTables;
  93. Var
  94.   Cnt : Word;
  95. Begin
  96. { Precalcualted values for movement.}
  97. { If you want do not precalculated them, you have time for playing with this }
  98. { values. Ok ? make a beatiful key-controlled hole! :)                       }
  99.   For Cnt:=0 to 255 do
  100.     Begin
  101.       SinMov[Cnt]:=round(sin(pi*Cnt/128)*20);
  102.       CosMov[Cnt]:=round(cos(pi*Cnt/128)*80);
  103.     End;
  104. { Precalculated sinus table. Only one table. I remember you: cos(φ)=sin(φ+90)}
  105. { The values are between -127 , 127 = 2^7                                    }
  106. {                        sal Var,7 for mul                                   }
  107. {                        sar Var,7 for div  (High speed.)                    }
  108.   For Cnt:=0 to 449 do SinTable[Cnt]:=round(sin(2*pi*Cnt/360)*128);
  109. End;
  110.  
  111. { Draw a point in Buffer.                              }
  112. {   ■ The middle of the screen = (160,100)             }
  113. {   ■ Center & Radius of Circle that we are drawing.   }
  114. {   ■ Angle                                            }
  115. {   ■ Color                                            }
  116. { This procedure uses parametrics formules of a circle:}
  117. {   x = XCenter + Radius * Cos (φ)                     }
  118. {   y = YCenter + Radius * Sin (φ)    φ ε [0..359°]    }
  119. Procedure DrawPoint(XCenter,YCenter,Radius,Angle:word;Color:byte);
  120. Var
  121.   X,Y:word;
  122. Begin
  123.   X:=(Radius*SinTable[90+Angle]);
  124.   asm sar x,7 end;
  125.   X:=160+XCenter+X;
  126.   Y:=(Radius*SinTable[Angle]);
  127.   asm sar y,7 end;
  128.   Y:=100+YCenter+Y;
  129.   if (X<320) and (Y<200) then
  130. { This is probably the most quick form for putting a pixel.}
  131.     Asm
  132.       mov  ax,BufferSeg
  133.       mov  es,ax
  134.       mov  al,Color
  135.       mov  bx,X
  136.       mov  dx,Y
  137.       xchg dh,dl
  138.       mov  di,dx
  139.       shr  di,1
  140.       shr  di,1
  141.       add  di,dx
  142.       add  di,bx
  143.       mov  es:[di],al
  144.     End;
  145. End;
  146.  
  147. { The MEOLLO. -.Spanish expresion ;-) }
  148. Procedure TheHole;
  149. Const
  150.   x  : Word =    0;
  151.   y  : Word =    0;
  152. Var
  153.   CntAng    : Word;
  154.   CntLong   : Word;
  155.   Color     : Byte;
  156. Begin
  157.   Repeat
  158. { Wait for vertical retrace.}
  159.     while (port[$3da] and 8) <> 0 do;
  160.     while (port[$3da] and 8) = 0 do;
  161.     Color:=19;
  162.     IncLong:=2;
  163.     CntLong:=10;
  164.     Repeat
  165.     { Draw a circle.}
  166.       CntAng:=0;
  167.       Repeat
  168.         DrawPoint(CosMov[(x+(200-CntLong)) mod 255],SinMov[(y+(200-CntLong)) mod 255],CntLong,CntAng,Color);
  169. { [ No move ] comment -^                     }
  170. {        DrawPoint(x,y,CntLong,CntAng,Color);}
  171.         Inc(CntAng,IncAng);
  172.       Until CntAng>=360;
  173.     { Ok the circle is drawing.}
  174.     { Another circle, another colour, until CntLong 220 :) }
  175.       inc(CntLong,IncLong);
  176.       if (CntLong mod 3)=0 then
  177.         begin
  178.           inc(IncLong);
  179.           inc(Color);
  180.           if Color>31 then Color:=31;
  181.         end;
  182.     Until CntLong>=220;
  183. { Moving, if no move the circles, NO MOVE.}
  184.     x:=XMov+x mod 255;
  185.     y:=YMov+y mod 255;
  186. { [ No move ] comment -^ You willl see the hole move NOTHING }
  187. {    x:=0; y:=0;}
  188.     PutBuffer;
  189.     ClearBuffer;
  190.   until keypressed;
  191. End;
  192. { Main.}
  193. BEGIN
  194. { Put MCGA On.}
  195.   asm
  196.     mov ax,13h
  197.     int 10h
  198.   end;
  199. { Memory for Buffer, If I have 64000 bytes Pascal give me a complete segment.}
  200. { Offset =0; but you can do it with less memory, using Memory unit and       }
  201. { MemAllocSeg Ok Eduard? ;-)                                                 }
  202.   GetMem(Buffer,64000);
  203.   BufferSeg:=seg(Buffer^);
  204.   ClearBuffer;
  205.   CalcTables;
  206.   MakeDegradated (50,50,64);
  207.   TheHole;
  208. { Remember Freemem.:) }
  209.   Freemem(Buffer,64000);
  210.   Textmode(lastmode);
  211. end.
  212.